Celestin Apprentice 4/Apprentice-Release4.iso/Demos/AppMaker 2.0b3/Demo AppMaker 1.5/Demo AppMaker™/Demo AppMaker™.rsrc/TmpP_151_Menu.File

Text File | 1992-04-08 | 5.0 KB | 277 lines

{ %filename% }
{ Created %date% %time% by AppMaker }

Unit %UnitName%;
Interface

Uses
    %if lang = MPW%
        Types,
        Quickdraw,
        Controls,
        Dialogs,
        Events,
        Lists,
        Menus,
        TextEdit,
        Desk,
        Packages,
        ToolUtils,

    %end if%
    %for each menuItem gen usesDialog%

    Globals,
    ResourceDefs,
    %appName%Data,
    Dispatcher,
    Miscellany;

{----------}
Procedure Init%MenuName%M;
Function  OkToOpen    (fType:            OSType): boolean;
Procedure OpenDoc     (fileName:        Str255;
                     vRefNum:        integer);
Procedure OpenApp;
Procedure DoClose;
Procedure DoQuit;
Procedure Do%MenuName%     (itemNr:    integer);

{----------}
Implementation

%if lang = MPW%
    {$D+}
    {$R+}
    {$OV+}
    {$S %unitname%}

%end if%
const
    dialogTop        = 75;
    dialogLeft        = 85;

var
    numOpenTypes:    integer;
    openTypeList:    SFTypeList;

{----------}
Procedure Init%MenuName%M;
Begin
    numOpenTypes := 1;
    openTypeList [0] := kFileType;
End; {Init%MenuName%M}

{----------}
Function OkToOpen    (fType:        OSType): boolean;
var
    i:                integer;
    status:            (searching, found, notFound);
Begin
    i := 0;
    status := searching;
    while status = searching do begin
        if i >= numOpenTypes then begin
            status := notFound;
        end else begin
            if fType = openTypeList [i] then begin
                status := found;
            end else begin
                i := i + 1;
            end;
        end;
    end; {while}
    OkToOpen := (status = found);
End; {OkToOpen}

{----------}
Procedure DoNew;
Begin
    OpenWindows ('', 0, 0);
    InitAppData;
End; {DoNew}

{----------}
Procedure OpenDoc    (fileName:        Str255;
                     vRefNum:        integer);
const
    StationeryFlag    = $0800;    {This *should* be defined in an Apple interface file}

var
    isStationery:    boolean;
    finderInfo:        FInfo;
    fRefNum:        integer;
Begin
    isStationery := false;
    if GetFInfo (fileName, vRefNum, finderInfo) = noErr then begin
        if BAnd (finderInfo.fdFlags, StationeryFlag) <> 0 then begin
            isStationery := true;
        end;
    end;
    if OpenAppFile (vRefNum, fileName, fRefNum) then begin
        if isStationery then begin
            OpenWindows ('', 0, 0);
            ReadAppFile (fRefNum);
            CloseAppFile (fRefNum);
        end else begin
            OpenWindows (fileName, vRefNum, fRefNum);
            ReadAppFile (fRefNum);
        end;
    end;
End; {OpenDoc}

{----------}
Procedure DoOpen;
var
    dialogOrigin:    Point;
    sfInfo:            SFReply;
Begin
    SetPt (dialogOrigin, dialogLeft, dialogTop);
    SFGetFile (dialogOrigin, '', nil, numOpenTypes, openTypeList, nil, sfInfo);
    with sfInfo do begin
        if good then begin
            OpenDoc (fName, vRefNum);
        end;
    end;
End; {DoOpen}

{----------}
Procedure OpenApp;
Begin
    DoNew;
End; {OpenApp}

{----------}
Procedure DoSaveAs;
var
    sfInfo:            SFReply;
    fRefNum:        integer;
    ok:                boolean;
    prompt:            StringHandle;
    suggestion:        Str255;
Begin
    prompt := GetString (SaveAsPromptID);
    suggestion := '';

    with sfInfo do begin
        if CreateFile (sfInfo, prompt^^, suggestion, kSignature, kFileType)
        then begin
            CloseAppFile (cur^.fileNum);
            if OpenAppFile (vRefNum, fName, fRefNum) then begin
                SetWTitle (curWindow, fName);
                cur^.fileNum := fRefNum;
                cur^.volNum := vRefNum;
                WriteAppFile (cur^.fileNum);
                cur^.dirty := false;
            end else begin {should never happen}
                SetWTitle (curWindow, '???');
                cur^.fileNum := 0;
                cur^.volNum := 0;
            end;
        end;
    end; {with}
End; {DoSaveAs}

{----------}
Procedure DoSave;
Begin
    if cur^.fileNum = 0 then begin
        DoSaveAs;
    end else begin
        WriteAppFile (cur^.fileNum);
        cur^.dirty := false;
    end;
End; {DoSave}

{----------}
Procedure CloseAppWindow;
const
    saveItem        = 1;
    cancelItem      = 2;
    discardItem     = 3;

var
    curTitle:        Str255;
    itemNum:        integer;
    ok:                boolean;
Begin
    ok := true;
    SetInfo (FrontWindow);
    if cur^.dirty then begin
        GetWTitle (curWindow, curTitle);
        ParamText (curTitle, '', '', '');
        InitCursor;
        itemNum := Alert (SaveID, nil);
        case itemNum of
            saveItem: begin
                    DoSave;
                    ok := not errorFlag;
                end;
            discardItem:
                   {Do nothing};
            cancelItem: begin
                    errorFlag := true;
                    ok := false;
                end;
        end; {case}
    end;
    if ok then begin
        DisposeAppData;
        if ord (cur^.windowKind) = 1 then begin {1st or only window in set}
            CloseAppFile (cur^.fileNum);
        end;
        CloseCurWindow;
    end;
End; {CloseAppWindow}

{----------}
Procedure DoClose;
var
    frontPeek:        WindowPeek;
Begin
    errorFlag := false;

    frontPeek := WindowPeek (FrontWindow);
    if frontPeek^.windowKind < 0 then begin
        CloseDeskAcc (frontPeek^.windowKind);
    end else if frontPeek^.windowKind = dialogKind then begin
        CloseModelessDialog (FrontWindow);
    end else begin
        CloseAppWindow;
    end;
End; {DoClose}

{----------}
Procedure DoQuit;
var
    quitting:        boolean;
Begin
    quitting := true;
    while quitting and (FrontWindow <> nil) do begin
        SystemTask;
        DoClose;
        if errorFlag then begin
            quitting := false;
        end;
    end; {while}

    if quitting then begin
        quittingTime := true;
    end;
End; {DoQuit}

%for each menuitem gen doItem%
{----------}
Procedure Do%MenuName%    (itemNr:    integer);
Begin
    errorFlag := false;

    case itemNr of
        0:    ;
        %for each menuitem gen handleitem%

    end; {case}
End; {Do%MenuName%}

End. {%UnitName%}